home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / ivbsrc / access.frm (.txt) next >
Encoding:
Visual Basic Form  |  1995-05-08  |  7.3 KB  |  205 lines
  1. VERSION 2.00
  2. Begin Form Form1 
  3.    Caption         =   "Form1"
  4.    ClientHeight    =   3480
  5.    ClientLeft      =   90
  6.    ClientTop       =   1350
  7.    ClientWidth     =   4995
  8.    Height          =   3885
  9.    Left            =   30
  10.    LinkMode        =   1  'Source
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   3480
  13.    ScaleWidth      =   4995
  14.    Top             =   1005
  15.    Width           =   5115
  16.    Begin CommandButton Command0 
  17.       Caption         =   "Create a test file on disk C:"
  18.       Height          =   375
  19.       Left            =   120
  20.       TabIndex        =   7
  21.       Top             =   3000
  22.       Width           =   3375
  23.    End
  24.    Begin CommandButton Command6 
  25.       Caption         =   "Quit"
  26.       Height          =   855
  27.       Left            =   3600
  28.       TabIndex        =   4
  29.       Top             =   2520
  30.       Width           =   1335
  31.    End
  32.    Begin CommandButton Command5 
  33.       Caption         =   "Clear array"
  34.       Height          =   375
  35.       Left            =   3600
  36.       TabIndex        =   3
  37.       Top             =   2040
  38.       Width           =   1335
  39.    End
  40.    Begin CommandButton Command4 
  41.       Caption         =   "Clear list box"
  42.       Height          =   375
  43.       Left            =   3600
  44.       TabIndex        =   6
  45.       Top             =   1560
  46.       Width           =   1335
  47.    End
  48.    Begin CommandButton Command3 
  49.       Caption         =   "Rewrite array"
  50.       Height          =   375
  51.       Left            =   3600
  52.       TabIndex        =   5
  53.       Top             =   1080
  54.       Width           =   1335
  55.    End
  56.    Begin CommandButton Command2 
  57.       Caption         =   "Load list box"
  58.       Height          =   375
  59.       Left            =   3600
  60.       TabIndex        =   2
  61.       Top             =   600
  62.       Width           =   1335
  63.    End
  64.    Begin CommandButton Command1 
  65.       Caption         =   "Create array"
  66.       Height          =   375
  67.       Left            =   3600
  68.       TabIndex        =   1
  69.       Top             =   120
  70.       Width           =   1335
  71.    End
  72.    Begin ListBox List1 
  73.       Height          =   2760
  74.       Left            =   120
  75.       TabIndex        =   0
  76.       Top             =   120
  77.       Width           =   3375
  78.    End
  79. Declare Function hread Lib "kernel" Alias "_hread" (ByVal hFile%, ByVal memAddr&, ByVal dwBytes&) As Long
  80. Declare Function lclose Lib "Kernel" Alias "_lclose" (ByVal hFile As Integer) As Integer
  81. Declare Function llseek Lib "Kernel" Alias "_llseek" (ByVal hFile As Integer, ByVal lOffset As Long, ByVal iOrigin As Integer) As Long
  82. Declare Function OpenFile Lib "Kernel" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Integer) As Integer
  83. '  OpenFile() Flags
  84. Const OF_READ = &H0
  85. Const OF_WRITE = &H1
  86. Const OF_CREATE = &H1000
  87. Declare Function GlobalAlloc Lib "Kernel" (ByVal wFlags As Integer, ByVal dwBytes As Long) As Integer
  88. Declare Function GlobalFree Lib "Kernel" (ByVal hMem As Integer) As Integer
  89. Declare Function GlobalLock Lib "Kernel" (ByVal hMem As Integer) As Long
  90. Declare Function GlobalUnlock Lib "Kernel" (ByVal hMem As Integer) As Integer
  91. Declare Function GlobalHandleToSel Lib "Toolhelp.dll" (ByVal hglb As Integer) As Integer
  92. Declare Function MemoryRead Lib "Toolhelp.dll" (ByVal wSel As Integer, ByVal dwOffset As Long, lpvBuf As Any, ByVal dwcb As Long) As Long
  93. Declare Function MemoryWrite Lib "Toolhelp.dll" (ByVal wSel As Integer, ByVal dwOffset As Long, lpvBuf As Any, ByVal dwcb As Long) As Long
  94. Const GMEM_MOVEABLE = &H2
  95. Const GMEM_ZEROINIT = &H40
  96. Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
  97. Dim f_Of As OFSTRUCT        'Open file structure record
  98. Dim f_File$                 'Name of file containing sample records
  99. Dim f_NbrRecs As Long       'Number of records in sample file
  100. Dim f_mHndl As Integer      'Memory handle to global memory
  101. Dim f_Rec As f_RecType      'Sample record
  102. Dim f_mSel%                 'Memory selector
  103. Dim f_LenRec&               'Length of sample record
  104. Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
  105. Declare Function GetFocus% Lib "User" ()
  106. Const WM_USER = &H400
  107. Const LB_RESETCONTENT = (WM_USER + 5)
  108. Sub Command0_Click ()
  109. 'Write a series of records to a disk file. We'll read this file
  110. 'into memory later.
  111.   Open "Sample.dat" For Random As #1 Len = Len(f_Rec)
  112.   For I& = 0 To 255
  113.     f_Rec.I = I&
  114.     f_Rec.L = I& * 2
  115.     f_Rec.C = I& * 3
  116.     f_Rec.S = I& / 10
  117.     f_Rec.D = I& / 100
  118.     f_Rec.ST = String$(30, I&)
  119.     Put 1, , f_Rec
  120.   Next I&
  121.   Close #1
  122. End Sub
  123. Sub Command1_Click ()
  124.   Call CreateHuge
  125. End Sub
  126. Sub Command2_Click ()
  127.   Call FillListBox
  128. End Sub
  129. Sub Command3_Click ()
  130.   For I& = 255 To 0 Step -1  'Write records to memory in reverse order
  131.     f_Rec.I = I&
  132.     f_Rec.L = I& * 2
  133.     f_Rec.C = I& * 3
  134.     f_Rec.S = I& / 10
  135.     f_Rec.D = I& / 100
  136.     f_Rec.ST = String$(30, I&)
  137.     J& = 255& - I&
  138.     rBytes& = MemoryWrite(f_mSel%, J& * f_LenRec&, f_Rec, f_LenRec&)
  139.   Next I&
  140. End Sub
  141. Sub Command4_Click ()
  142.   List1.SetFocus
  143.   ret& = SendMessage(GetFocus(), LB_RESETCONTENT, 0, 0&)
  144. End Sub
  145. Sub Command5_Click ()
  146.   Ok% = GlobalFree(f_mHndl)
  147. End Sub
  148. Sub Command6_Click ()
  149.   End
  150. End Sub
  151. Sub CreateHuge ()
  152. '--- creates huge array of records from sample file. The records are in a
  153. '    type structure defined as "f_RecType".
  154.   f_File$ = "Sample.dat"
  155.   '--- open the data file for reading
  156.   hFile = OpenFile(f_File$, f_Of, OF_READ)
  157.   '--- get the size of the file
  158.   size& = llseek(hFile, 0&, 2)
  159.         
  160.   '--- determine how many records are in the file
  161.   f_NbrRecs = size& \ Len(f_Rec)
  162.         
  163.   '--- reset the file pointer to the start of the file
  164.   rs& = llseek(hFile, 0&, 0)
  165.         
  166.   '--- create the global memory object
  167.   f_mHndl = GlobalAlloc(GHND, size&)
  168.   '--- make sure enough memory is available
  169.   If f_mHndl = 0 Then
  170.     Beep
  171.     MsgBox "Insufficient memory to allocate array", 16, ""
  172.     Exit Sub
  173.   End If
  174.   '--- get the address of the memory object
  175.   lpAddr& = GlobalLock(f_mHndl)
  176.   '--- read the data file into the memory object
  177.   inBytes& = hread(hFile, ByVal lpAddr&, size&)
  178.         
  179.   '--- close the file
  180.   cl = lclose(hFile)
  181.   '--- unlock the memory object
  182.   e = GlobalUnlock(f_mHndl)
  183. End Sub
  184. Sub FillListBox ()
  185. '--- get the array memory object selector
  186. '=================================================================
  187. '    this only needs to be done once in any form or routine.
  188. '    Note that memory is NOT locked. It doesn't need to be in
  189. '    in protected mode so the selector is valid even if the memory
  190. '    object gets moved.  As this routine requires the Win 3.1 API
  191. '    calls, the app will always be running in protected mode.
  192. '=================================================================
  193.   f_mSel% = GlobalHandleToSel(f_mHndl)
  194.   f_LenRec& = Len(f_Rec)
  195.   '--- read records from array (f_NbrRecs is total # of records)
  196.   For L& = 0 To f_NbrRecs - 1
  197.         
  198.     '--- read a record from array into f_Rec record structure
  199.     rBytes& = MemoryRead(f_mSel%, L& * f_LenRec&, f_Rec, f_LenRec&)
  200.     '--- add record to listbox
  201.     T$ = Str$(f_Rec.I) + Str$(f_Rec.L) + Str$(f_Rec.C) + Str$(f_Rec.S) + Str$(f_Rec.D) + "  " + f_Rec.ST
  202.     List1.AddItem T$
  203.   Next L&
  204. End Sub
  205.